private import base;
private import sequences;
private import strings;
private import casting;
private import macrosupport;

-- Package to facilitate conversion of quoted form to actual values

private type possible of %t is impossible or exactly(%t);

implementation coercion over (quoted,string) is {
coerce(stringAst(_,S)) is S;
coerce(<|nonString|>) is nonString;
coerce(Q) is raise "$Q is not a string";
}

implementation coercion over (quoted,integer) is {
coerce(integerAst(_,S)) is S;
coerce(<|nonInteger|>) is nonInteger;
coerce(Q) is raise "$Q is not an integer";
}

implementation coercion over (quoted,long) is {
coerce(longAst(_,S)) is S;
coerce(<|nonLong|>) is nonLong;
coerce(Q) is raise "$Q is not a long";
}

implementation coercion over (quoted,float) is {
  coerce(floatAst(_,S)) is S;
  coerce(<|nonFloat|>) is nonFloat;
  coerce(Q) is raise "$Q is not a float";
}

findQField(Q,Name) is let{
findQF(_,E matching exactly(_)) is E;
findQF(<| ?L ; ?R |>,M) is findQF(R,findQF(L,M));
findQF(<| ?F = ?V |>,_) where F matches nameAst(_,Nm) and Nm=Name is exactly(V);
findQF(_,_) default is impossible;

unpack(exactly(S)) is S;
unpack(impossible) is raise "$Name is not present";
} in unpack(findQF(Q,impossible));

# prefix("dequoteable",1300);

# dequoteable ?Stmt :: statement :- Stmt :: statement;

# dequoteable type ?Ptn is ?Spec ==> #(
type Ptn is Spec;
implementation template(Ptn) is {
 coerce(X) is dequote(X)
} using {
 genDequote(Spec)
}
)# ## {
# genDequote(?L or ?R) ==> #( genDequote(L) ; genDequote(R) )#;
# genDequote(?ConSpec) ==> genDequoteCon(ConSpec);

# genDequoteCon(#(?H)#{?A}) ==>
#( dequote(<| H{ #(?)#(#$A) } |>) is H{ #*genFields(A,#$A) } )# ## {
  #genFields( #( ?F has type ?Tp )#,?Arg ) ==>
      #( F = findQField( Arg, $$F) as Tp )#;
  #genFields( #( ?L ; ?R )#,?Arg ) ==>
      #( genFields(L,Arg) ; genFields(R,Arg) )#;
};
# genDequoteCon(identifier ? I) ==> #( dequote(<| I |>) is I )#;
# genDequoteCon( #(?O #@ ?A)#) ==> #( dequote(<| Con |>) is Term; dequote(XX) is raise "cannot dequote $XX" )# ##{
  #gnArgs((?A1,?R1)) ==> ((#(?)#(#$A),first(Rgs)), ((#$A as A1),second(Rgs))) ## {
    #Rgs ==> gnArgs(R1);
  }
  #gnArgs(()) ==> ((),());

  #genArgs ==> gnArgs(#:A);
  #Con ==> O #@ #<first(genArgs) >#;
  #Term ==> O #@ #<second(genArgs) >#;
};

# first( (?F,?S)) ==> F;
# second(( ?F,?S)) ==> S;

# template(identifier?Tp) ==> coercion over (quoted,Tp);
# template(?Tp of ?Args) ==> #( coercion over (quoted,Tp of Args) where findRequirements(Args) )# ## {
  #findRequirements(tuple?T) ==> composeConstraints(findReqs(#:T));
  #findRequirements(?T) ==> composeConstraints(findReqs((T,())));

  #findReqs(()) ==> ();
  #findReqs((?L,?R)) ==> (coercion over (quoted,L),findReqs(R));

  #composeConstraints((?C,())) ==> C;
  #composeConstraints((?L,?R)) ==> #( L 'n composeConstraints(R) )#;
}
}
